home *** CD-ROM | disk | FTP | other *** search
/ 1,000+ Hot Games / 1000-Plus-Hot-Games-1999.zip / 1000+ Hot Games (1999) / PROGRAMS / CARDWS17 / INC / TILES.CDH < prev   
Text File  |  1994-03-26  |  11KB  |  399 lines
  1. #ifndef cwstiles
  2. #define cwstiles
  3.  
  4. #include 'function.cdh'
  5. #include 'predicat.cdh'
  6.  
  7. {--------------------------------------------------------------------------}
  8.  
  9. object stack is
  10.   function CanReceive : Index;
  11.   predicate IsFree?(l : Index);
  12.   const size : integer;
  13.   var Left : integer, Right : integer;
  14. end stack;
  15.  
  16. {--------------------------------------------------------------------------}
  17.  
  18. cards tile is
  19.   W := 7;
  20.   H := 7;
  21.   RatioW := 0;
  22.   RatioH := 0;
  23.   Default := EmptySpace;
  24.   Init is
  25.     begin
  26.     Face 1..255 is NORMAL Horizontal;
  27.     Face 0 is Face emptyspace;
  28.     Face 1 is BITMAP 'tiles/tile01.bmp';
  29.     Face 2 is BITMAP 'tiles/tile02.bmp';
  30.     Face 3 is BITMAP 'tiles/tile03.bmp';
  31.     Face 4 is BITMAP 'tiles/tile04.bmp';
  32.     Face 5 is BITMAP 'tiles/tile05.bmp';
  33.     Face 6 is BITMAP 'tiles/tile06.bmp';
  34.     Face 7 is BITMAP 'tiles/tile07.bmp';
  35.     Face 8 is BITMAP 'tiles/tile08.bmp';
  36.     Face 9 is BITMAP 'tiles/tile09.bmp';
  37.     Face 10 is BITMAP 'tiles/tile10.bmp';
  38.     Face 11 is BITMAP 'tiles/tile11.bmp';
  39.     Face 12 is BITMAP 'tiles/tile12.bmp';
  40.     Face 13 is BITMAP 'tiles/tile13.bmp';
  41.     Face 14 is BITMAP 'tiles/tile14.bmp';
  42.     Face 15 is BITMAP 'tiles/tile15.bmp';
  43.     Face 16 is BITMAP 'tiles/tile16.bmp';
  44.     Face 17 is BITMAP 'tiles/tile17.bmp';
  45.     Face 18 is BITMAP 'tiles/tile18.bmp';
  46.     Face 19 is BITMAP 'tiles/tile19.bmp';
  47.     Face 20 is BITMAP 'tiles/tile20.bmp';
  48.     Face 21 is BITMAP 'tiles/tile21.bmp';
  49.     Face 22 is BITMAP 'tiles/tile22.bmp';
  50.     Face 23 is BITMAP 'tiles/tile23.bmp';
  51.     Face 24 is BITMAP 'tiles/tile24.bmp';
  52.     Face 25 is BITMAP 'tiles/tile25.bmp';
  53.     Face 26 is BITMAP 'tiles/tile26.bmp';
  54.     Face 27 is BITMAP 'tiles/tile27.bmp';
  55.     Face 28 is BITMAP 'tiles/tile28.bmp';
  56.     Face 29 is BITMAP 'tiles/tile29.bmp';
  57.     Face 30 is BITMAP 'tiles/tile30.bmp';                                        
  58.     Face 31 is BITMAP 'tiles/tile31.bmp';
  59.     Face 32 is BITMAP 'tiles/tile32.bmp';
  60.     Face 33 is BITMAP 'tiles/tile33.bmp';
  61.     Face 34 is BITMAP 'tiles/tile34.bmp';
  62.     Face 35 is BITMAP 'tiles/tile35.bmp';
  63.     Face 36 is BITMAP 'tiles/tile36.bmp';
  64.     Face 52..103 is BITMAP 'tiles/tile00.bmp';
  65.     Face 104 is Face 0 side shaded;
  66.     Face 105 is Face 1 side shaded;
  67.     Face 106 is Face 2 side shaded;
  68.     Face 107 is Face 3 side shaded;
  69.     Face 108 is Face 4 side shaded;
  70.     Face 109 is Face 5 side shaded;
  71.     Face 110 is Face 6 side shaded;
  72.     Face 111 is Face 7 side shaded;
  73.     Face 112 is Face 8 side shaded;
  74.     Face 113 is Face 9 side shaded;
  75.     Face 114 is Face 10 side shaded;
  76.     Face 115 is Face 11 side shaded;
  77.     Face 116 is Face 12 side shaded;
  78.     Face 117 is Face 13 side shaded;
  79.     Face 118 is Face 14 side shaded;
  80.     Face 119 is Face 15 side shaded;
  81.     Face 120 is Face 16 side shaded;
  82.     Face 121 is Face 17 side shaded;
  83.     Face 122 is Face 18 side shaded;
  84.     Face 123 is Face 19 side shaded;
  85.     Face 124 is Face 20 side shaded;
  86.     Face 125 is Face 21 side shaded;
  87.     Face 126 is Face 22 side shaded;
  88.     Face 127 is Face 23 side shaded;
  89.     Face 128 is Face 24 side shaded;
  90.     Face 129 is Face 25 side shaded;
  91.     Face 130 is Face 26 side shaded;
  92.     Face 131 is Face 27 side shaded;
  93.     Face 132 is Face 28 side shaded;
  94.     Face 133 is Face 29 side shaded;
  95.     Face 134 is Face 30 side shaded;
  96.     Face 135 is Face 31 side shaded;
  97.     Face 136 is Face 32 side shaded;
  98.     Face 137 is Face 33 side shaded;
  99.     Face 138 is Face 34 side shaded;
  100.     Face 139 is Face 35 side shaded;
  101.     Face 140 is Face 36 side shaded;
  102.     end;
  103. end tile;
  104.  
  105. const EmptyTile := 0;
  106.  
  107. {--------------------------------------------------------------------------}
  108.  
  109. var fs : stack, fp : Index,
  110.     removedtiles, totaltiles : integer;  
  111.  
  112. {--------------------------------------------------------------------------}
  113.  
  114. function RandomStack(g : group; l : integer) : stack is
  115. var i : integer;
  116. begin
  117.   i:=random(l);
  118.   with it do
  119.     if i=0 then return it
  120.     else i:=i-1
  121.   for g;
  122. end;
  123.  
  124. {--------------------------------------------------------------------------}
  125.  
  126. stack procedure RmAt(l : index) is
  127. begin
  128.   if (l=Left) and (Left=Right) then 
  129.     begin
  130.     Left:=0;
  131.     Right:=0;
  132.     end
  133.   else if (l=Left) then Left:=Left+1
  134.   else if (l=Right) then Right:=Right-1;  
  135.   [l]:=EmptyTile;
  136. end;
  137.  
  138. stack predicate IsCover?(s : stack; l, o : Index) is
  139.   if ([l]=EmptyTile) or ((l<>Left) and (l<>Right)) then return FALSE
  140.   else 
  141.     begin
  142.     l:=l+o;
  143.     if (l<1) or (l>s.Size) then return TRUE
  144.     else if s[l]=EmptyTile then return TRUE
  145.     else return FALSE;
  146.     end;
  147.  
  148. {--------------------------------------------------------------------------}
  149.  
  150. stack procedure PutAt(l : index; c : card) is
  151. begin
  152.   if (l<Left) or (Left=0) then Left:=l;
  153.   if (l>Right) or (Right=0) then Right:=l;
  154.   [l]:=c;
  155. end;
  156.  
  157. stack function SlideL2R(l, r : index) : Index is
  158.   if (Left=0) or (l>Right) or (r<Left) then return r
  159.   else if l>=Left then return 0
  160.   else return Left-1;
  161.  
  162. stack function SlideR2L(l, r : index) : Index is
  163.   if (Right=0) or (l>Right) or (r<Left) then return l
  164.   else if r<=Right then return 0
  165.   else return Right+1;
  166.  
  167. stack function PutIn(l, r : index) : Index is
  168.   return random(r-l+1)+l;
  169.  
  170. stack predicate IsEmpty?(l, r : index) is
  171.   return (Left=0) or (Left>r) or (Right<l);
  172.  
  173. stack function FirstLeftIn(l, r : Index): Index is
  174.   if (Left=0) or (l>Right) or (r<Left) then return 0
  175.   else if l>=Left then return l
  176.   else return Left;
  177.  
  178. stack function FirstRightIn(l, r : Index): Index is
  179.   if (Left=0) or (l>Right) or (r<Left) then return 0
  180.   else if r<=Right then return r
  181.   else return Right;
  182.  
  183. stack function CoverRC(s : stack; l, r, o : Index) : Index is
  184. var l2, r2 : Index;
  185. begin
  186.   l2:=s.FirstLeftIn(l,r);
  187.   if l2=0 then return 0;
  188.   r2:=s.FirstRightIn(l,r);
  189.   l2:=l2-o;
  190.   r2:=r2-o;
  191.   if IsEmpty?(l2,r2) then return PutIn(l2,r2) 
  192.   else if random(2)=0 then return SlideL2R(l2,r2)
  193.   else return SlideR2L(l2,r2);
  194. end;
  195.  
  196. {--------------------------------------------------------------------------}
  197.  
  198. stack procedure MultAdd(n : integer; c : card) is
  199.   while n>0 do 
  200.     begin
  201.     Add c;
  202.     n:=n-1;
  203.     end;
  204.  
  205. {--------------------------------------------------------------------------}
  206.  
  207. stack procedure TilesInit is
  208. begin
  209.   MultAdd(Size,EmptyTile);
  210.   Left:=0;
  211.   Right:=0;
  212.   Draw;
  213. end;
  214.  
  215. stack procedure TilesShuffle(g : group) is
  216. var s1, s2 : stack,
  217.     p1, p2 : Index,
  218.     gl, al : integer;
  219. begin
  220.   gl:=0;
  221.   totaltiles:=0;
  222.   with it do 
  223.     begin
  224.     gl:=gl+1;
  225.     totaltiles:=totaltiles + it.Size;
  226.     end
  227.   for g;
  228.   al:=totaltiles / 2;
  229.   while al>0 do
  230.     begin
  231.     add 1 .. min(36,al) to Cursor;
  232.     al:=al-36;
  233.     end; 
  234.   Shuffle Cursor;
  235.   Turn Cursor[1..Cursor!] side down;
  236.   while Cursor!>0 do
  237.     begin
  238.     p1:=0;
  239.     while p1=0 do
  240.       begin
  241.       s1:=RandomStack(g,gl);
  242.       p1:=s1.CanReceive;
  243.       end;
  244.     p2:=0;
  245.     while p2=0 do
  246.       begin
  247.       s2:=RandomStack(g,gl);
  248.       p2:=s2.CanReceive;
  249.       end;
  250.     if s1<>s2 then
  251.       begin
  252.       s1.PutAt(p1,Cursor[Cursor!]);
  253.       s2.PutAt(p2,Cursor[Cursor!]);
  254.       draw s1; draw s2;
  255.       Remove Cursor[Cursor!];
  256.       end
  257.     else if Cursor!<18 then
  258.       //else do some shuffle so we don't get stuck
  259.       begin
  260.       p2:=0;
  261.       while (s1=s2) or (p2=0) do 
  262.         begin
  263.         s2:=RandomStack(g,gl);
  264.         if Random(2)=0 then p2:=s2.Left
  265.         else p2:=s2.Right;
  266.         if not (s2.IsFree?(p2)) then p2:=0;
  267.         end;
  268.       s1.PutAt(p1,s2[p2]);
  269.       s2.RmAt(p2);  
  270.       draw s1; draw s2;
  271.       end;  
  272.     end;
  273.   with it do
  274.     turn it[1..it!] side up
  275.   for g;
  276.   fs:=Cursor;
  277.   fp:=0;
  278.   removedtiles:=0;
  279. end;
  280.  
  281. stack procedure SelectTile(Spos : Index) is
  282. begin
  283.   if Spos>! then Spos:=!;
  284.   if IsFree?(Spos) then
  285.     if IsShaded?([Spos]) then 
  286.       begin
  287.       fs:=Cursor;
  288.       fp:=0;
  289.       Turn [Spos] side up;
  290.       end
  291.     else if fs<>Cursor then
  292.       if SameCard?(fs[fp],[Spos]) then
  293.         begin
  294.         RmAt(Spos);
  295.         fs.RmAt(fp);
  296.         removedtiles:=removedtiles+2;
  297.         fs:=Cursor;
  298.         fp:=0;
  299.         end
  300.       else
  301.         begin
  302.         Turn fs[fp] side up;
  303.         fs:=Cursor;
  304.         fp:=0;
  305.         end
  306.     else 
  307.       begin
  308.       Turn [Spos] side shaded;
  309.       fs:=self;
  310.       fp:=Spos;
  311.       end;
  312. end;
  313.  
  314. stack procedure ShowAll(g : group) is
  315. var x1, x2, x3, y1, y2, y3 : integer,
  316.     i : card;
  317. begin
  318.   x1:=0;
  319.   x2:=0;
  320.   x3:=0;
  321.   y1:=0;
  322.   y2:=0;
  323.   y3:=0;
  324.   with it do
  325.     begin
  326.     if (it.Left>0) and it.IsFree?(it.Left) then 
  327.       begin
  328.       i:=(it[it.Left]-1) mod DeckSize;
  329.       if i<=14 then
  330.         begin
  331.         if (x1 and (1 << i))<>0 then y1:=y1 or (1 << i);
  332.         x1:=x1 or (1 << i);
  333.         end
  334.       else if i<=29 then 
  335.         begin
  336.         if (x2 and (1 << (i-15)))<>0 then y2:=y2 or (1 << (i-15));
  337.         x2:=x2 or (1 << (i-15));
  338.         end
  339.       else 
  340.         begin
  341.         if (x3 and (1 << (i-30)))<>0 then y3:=y3 or (1 << (i-30));
  342.         x3:=x3 or (1 << (i-30));
  343.         end;
  344.       end;
  345.     if (it.Right<>it.Left) and (it.IsFree?(it.Right)) then 
  346.       begin
  347.       i:=(it[it.Right]-1) mod DeckSize;
  348.       if i<=14 then
  349.         begin
  350.         if (x1 and (1 << i))<>0 then y1:=y1 or (1 << i);
  351.         x1:=x1 or (1 << i);
  352.         end
  353.       else if i<=29 then 
  354.         begin
  355.         if (x2 and (1 << (i-15)))<>0 then y2:=y2 or (1 << (i-15));
  356.         x2:=x2 or (1 << (i-15));
  357.         end
  358.       else 
  359.         begin
  360.         if (x3 and (1 << (i-30)))<>0 then y3:=y3 or (1 << (i-30));
  361.         x3:=x3 or (1 << (i-30));
  362.         end;
  363.       end;
  364.     end
  365.   for g;
  366.   with it do
  367.     begin
  368.     if (it.Left>0) and it.IsFree?(it.Left) then 
  369.       begin
  370.       i:=(it[it.Left]-1) mod DeckSize;
  371.       if i<=14 then
  372.         if (y1 and (1 << i))<>0 then Flash it[it.Left]
  373.         else
  374.       else if i<=29 then 
  375.         if (y2 and (1 << (i-15)))<>0 then Flash it[it.Left]
  376.         else
  377.       else 
  378.         if (y3 and (1 << (i-30)))<>0 then Flash it[it.Left];
  379.       end;
  380.     if (it.Right<>it.Left) and (it.IsFree?(it.Right)) then 
  381.       begin
  382.       i:=(it[it.Right]-1) mod DeckSize;
  383.       if i<=14 then
  384.         if (y1 and (1 << i))<>0 then Flash it[it.Right]
  385.         else
  386.       else if i<=29 then 
  387.         if (y2 and (1 << (i-15)))<>0 then Flash it[it.Right]
  388.         else
  389.       else 
  390.         if (y3 and (1 << (i-30)))<>0 then Flash it[it.Right];
  391.       end;
  392.     end
  393.   for g;
  394. end;
  395.  
  396. predicate win? is
  397.   return removedtiles=totaltiles;
  398.  
  399. #endif